VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFileApprove"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Function CreateApproveFile(lngInterfaceNo As Long, Optional strFailReason As String) As Boolean

    Dim strXmlHeader As String
    Dim strXmlVersDtdHeader As String
    Dim lngNewInterfaceNo As Long
    Dim strNewMsgId As String
    Dim strOraErr As String

    ClearIdxVars
    
    If Not ConnectToDb(strOraErr) Then
        WriteToErr "Error connecting to database: " & strOraErr
        Exit Function
    End If

    'barb: set these = nothing eventually
    Set objFileError = New clsFileApprove
    Set objFunctions = New clsApproveFunctions
    Set objReg = New clsReg
    Set objSendEMail = New clsSendEMail
    
    If objFunctions.ExtractIndexBlobFromDb(lngInterfaceNo) = True Then
 '           If objFunctions.ValidateXmlFormat(strFailReason) Then
                If objFunctions.GetHeaderData Then
                    'If objFunctions.ValidateHeaderData(strFailReason) Then
                        strXmlHeader = objFunctions.CreateXmlHeader
                        'produce error file
                        strXmlVersDtdHeader = objFunctions.CreateXmlVersionDtdHeader
                        'If objFunctions.CreateFileApproval(strXmlHeader, strXmlError) Then
                            adoConn.BeginTrans
                            If objFunctions.InsertIntoInterfaceIndex(lngNewInterfaceNo, strNewMsgId) Then
                                If objFunctions.InsertIntoInterfaceXml(lngNewInterfaceNo, strNewMsgId, strXmlVersDtdHeader, strXmlHeader) Then
                                    adoConn.CommitTrans
'                                    adoConn.BeginTrans
'                                    If objFunctions.UpdateInterfaceIndex Then
'
'                                    Else
'
'                                    End If
                                    CreateApproveFile = True
                                Else
                                    adoConn.RollbackTrans
                                    strFailReason = "Error file handle failed"
                                    CreateApproveFile = False
                                End If
                                    
                            Else
                                adoConn.RollbackTrans
                                strFailReason = "InsertIntoInterfaceIndex failed"
                                CreateApproveFile = False
                            End If
                        
'                    Else
'                        CreateApproveFile = False
'                    End If
'                Else
'                    strFailReason = "GetHeaderData failed"
'                    CreateApproveFile = False
'                End If
            Else
                strFailReason = "ValidateXmlFormat failed: " & strFailReason
                CreateApproveFile = False
            End If
    Else
        strFailReason = "ExtractIndexBlobFromDb failed"
        CreateApproveFile = False
    End If
    
End Function

Public Function XmlTest() As Boolean
    
'use this to test input
'send in temp file to copy image to from db
'this is where we go get the segments stored in the db and glue them together
'still need to loop thru db and find a way to view/display each file

     Dim rsBlob As ADODB.Recordset
     Dim arrBlob() As Byte
     Dim iFree As Integer
     Dim lngBlobLen As Long
     Dim lngRemainder As Long
     Dim lngNumOfSections As Long
     Dim strSql As String
     Dim BlobHolder As Variant
     Dim i As Integer
     Dim strTemp As String

     Const SEGMENT_LENGTH As Long = 4096

    On Error GoTo XmlTestFix

     iFree = FreeFile

     'initilize the recordset
     Set rsBlob = New ADODB.Recordset
     rsBlob.CursorType = adOpenKeyset
     rsBlob.LockType = adLockOptimistic
     'rsBlob.open "select * from VCO_LONGRAW_IMAGES where VLI_VSM_ID = '" & strID & "' and VLI_PAGE_NO = " & strPageNo, objAdoConn.Connection
     
    'strSql = "Select XML_STRING from DIR_INTERFACE_INDEX I, DIR_INTERFACE_XML X"
    strSql = "Select * from DIR_INTERFACE_INDEX I, DIR_INTERFACE_XML X"
    strSql = strSql & " where I.MQ_STATUS = '01'"
    strSql = strSql & " and I.INTERFACE_NO = X.INTERFACE_NO"
    strSql = strSql & " and I.MESSAGE_ID = X.MESSAGE_ID"
    Set rsBlob = adoConn.Execute(strSql)
     
     
'     rsBlob.MoveFirst
'
'     'get the length of the blob
'     lngBlobLen = rsBlob!XML_STRING.ActualSize
'
'     'get the number of sections that will be the number of elements in the sections array
'     lngNumOfSections = lngBlobLen \ SEGMENT_LENGTH
'
'     'get the leftover bytes that aren't divisible by the section_length
'     lngRemainder = lngBlobLen Mod SEGMENT_LENGTH
'
'     If lngRemainder <> 0 Then 'add the remaider
'         arrBlob = rsBlob(0).GetChunk(lngRemainder)
'     End If


    rsBlob.MoveFirst
     
     'barb: get idx vars here
     'IdxVars.

     'get the length of the blob
     lngBlobLen = rsBlob!XML_STRING.ActualSize

     'get the number of sections that will be the number of elements in the sections array
     lngNumOfSections = lngBlobLen \ SEGMENT_LENGTH

     'get the leftover bytes that aren't divisible by the section_length
     lngRemainder = lngBlobLen Mod SEGMENT_LENGTH

     If lngRemainder <> 0 Then 'add the remaider
         'arrBlob = rsBlob(0).GetChunk(lngRemainder)
         arrBlob = rsBlob!XML_STRING.GetChunk(lngRemainder)
     End If

    Dim strNewFilename As String
    strNewFilename = "C:\temp\XmlTest\1.txt"

     If Dir(strNewFilename) <> "" Then
         Kill strNewFilename
     End If

     'open the new file to put the data into
     Open strNewFilename For Binary Access Write As iFree

         'put the remainder first
         Put iFree, , arrBlob
         strTemp = CStr(arrBlob)

         'loop for the rest
         For i = 1 To lngNumOfSections
             'arrBlob = rsBlob(0).GetChunk(SEGMENT_LENGTH)
             arrBlob = rsBlob!XML_STRING.GetChunk(SEGMENT_LENGTH)
             'strTemp = strTemp & CStr(arrBlob(i - 1))
             strTemp = strTemp & CStr(arrBlob)
             Put iFree, , arrBlob
         Next

         Close iFree

     rsBlob.Close

    Debug.Print strTemp

    XmlTest = True

    Exit Function
    
XmlTestFix:
    WriteToErr "XmlTest: " & Err.Number & " - " & Err.Description
    XmlTest = False
End Function


    

Public Function GetHeaderFromText() As String

    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim lPos As Long
    Dim strTypeOfRequest As String
    
    On Error GoTo GetHeaderFromTextFix
    
    lPos = InStr(1, IdxVars.XmlString, "</Tracking>")
    If lPos <> 0 Then
        'get text up til end of header then close root node
        strTemp1 = Mid(IdxVars.XmlString, 1, lPos + 11)
        'remove version & dtd line
        lPos = InStr(1, strTemp1, ".dtd") + 8
        If lPos > 0 Then
            strTemp2 = Mid(strTemp1, lPos, Len(strTemp1) - lPos)
        End If
        'change KeyTax Type to "10" for error
        lPos = InStr(1, strTemp2, "<KeyTax Type=") + 13
        If lPos > 0 Then
            Select Case IdxVars.KeyTaxType
                Case "01", "03", "07", "08"
                Case Else
                    IdxVars.KeyTaxType = Mid(strTemp2, lPos + 1, 2)
            End Select
            strTemp1 = Mid(strTemp2, 1, lPos) & "" & "10" & """"
            strTemp1 = strTemp1 & Mid(strTemp2, lPos + 4, Len(strTemp2))
        End If
        'change the Request Status to "15" for error
        lPos = InStr(1, strTemp1, "<RequestStatus Type=") + 20
        If lPos > 0 Then
            strTemp2 = Mid(strTemp1, 1, lPos) & "" & "15" & """"
            strTemp2 = strTemp2 & Mid(strTemp1, lPos + 4, Len(strTemp1))
        End If
        
        strTemp2 = strTemp2 & "</KeyTax>"
        
        
        GetHeaderFromText = strTemp2
    Else
        GetHeaderFromText = ""
    End If
    
    Exit Function
    
GetHeaderFromTextFix:
    WriteToErr "GetHeaderFromText: " & Err.Number & " - " & Err.Description
    GetHeaderFromText = ""
End Function
Private Sub ClearIdxVars()

    'barb: start here
    'validation + "" and "NULL"
    'clean up
    'johan to write to created_date
    'sort out dtd location
    'remove all apostrophes from database data before inserting/updating

    IdxVars.InterfaceNo = 0
    IdxVars.XmlString = ""
    IdxVars.CreatedDated = ""
    IdxVars.SarsResponseYn = ""
    IdxVars.KeyTaxType = ""
    IdxVars.MqStatus = ""

    'Tracking Vars
    IdxVars.Tracking.MsgId = ""
    IdxVars.Tracking.ComId = ""
    IdxVars.Tracking.BuId = ""
    IdxVars.Tracking.ReferenceId = ""
    IdxVars.Tracking.ReqSeqNum = ""
    IdxVars.Tracking.RequestStatus = ""

    'Requestor Vars
    IdxVars.Request.Date = ""
    IdxVars.Request.Email = ""
    IdxVars.Request.Name = ""
    IdxVars.Request.Time = ""
    IdxVars.Request.UserId = ""

End Sub
